ETO Development Tools 4/ETO Development Tools 4.iso/Essentials/MacApp Documentation/MacApp.TECH$ Archives/1991/Feb 91/MacApp.Tech$ 2⁄8⁄91/2838-Re Dynamic Arrays in-Feb91

Text File | 1991-03-06 | 6.3 KB | 286 lines | [TEXT/GEOL]

Item    0789348                         2-Feb-91        18:32PST

From:   AUST0363                        AUDev - Repertoire Pty Ltd, SA,IDV

To:     PEMD                            CH DEV PEMD Group, Zurich,IDV
        MACAPP.TECH$                    MacApp Technical

------------------------------------------------------------------------------

Sub:    Re: Dynamic Arrays in Pascal?

Earnie,
        Your best bet (and the one that I use all the time) is to declare a
handle to the array and then resize the array dynamically (as suggested by
Bruce).  I embedd this in an object that mimics array functionality (but
without the TList ability to delete/insert while doing an Each).  I have
written an MPW tool that takes a resource description of the type of data that
the list should hold and what kind of operations should be included (e.g. Find
methods that search for particular subcomponents of the usually compound-record
data) and generates the entire unit.  The beauty of doing this is that you can
included it in your make file to regenerate as neccessary (i.e. when the list
definition or implementation changes).  Also you can write a cool front end to
edit the resources that are fed in.  For example the following is the resource
and some output of the tool for a resource list that I generated.  It will show
you what I am talking about, as well as the kind of interface I would
recommend.  I would also recommend Jeffs suggestion of keeping strings in
seperate storage.  Usually strings have different allocation dynamics than
general handles and you can optimize the memory management of them yourself,
especially strings that for e.g. are read in and not changed.

Anyway, the example is.

Resource input. (Needless to say I also have a tool to convert between pure
code text and Rez format strings)

resource 'CGEN' (0, "TResTypeList") {
   RecordList{
   "ResTypeList", "ResTypeRec",
   {
   Uses {{ "Resources" }},

   Types {{
   "ResTypeRec = record",
   "   fResType: ResType;",
   "   fCount  : integer;",
   "   fView   : TView;",
   "end;"
   }},

   FindMethods {
   kMTFind,
   "",
   { "ResType" },
   {
   "begin",
   "   TestProc := fData [index].fResType = key1;",
   "end;"
   }
   },

   FindMethods {
   kMTFindNth + kMTCountOf,
   "NonZeroType",
   { },
   {
   "begin",
   "   TestProc := fData [index].fCount <> 0;",
   "end;"
   }
   },

   DynamicFields {{
   "Var",
   "   result  : Str255;",
   "   resCountString  : Str255;",
   "",
   "begin",
   "   result [0] := Chr (4);",
   "   result [1] := theData.fResType [1];",
   "   result [2] := theData.fResType [2];",
   "   result [3] := theData.fResType [3];",
   "   result [4] := theData.fResType [4];",
   "   NumToString (theData.fCount, resCountString);",
   "   result := Concat (result, ' ', resCountString);",
   "   DoToField (indexString, @result, bString);",
   "   DoToField (Concat (indexString, '.fView'), @theData.fView, bObject);",
   "end;"
   }}
   }
   }
};

Some output.

Unit UResTypeList;

INTERFACE

   Uses
   { • MacApp }
   UMacApp

   { • Building Blocks }

   { • Interface }
   , UUndoingObject

   { • Implementation }
   , Resources
   , Packages
   , Types
   ;


   Type


   ResTypeRec = record
   fResType: ResType;
   fCount  : integer;
   fView   : TView;
   end;


   Type


   TResTypeList = Object (TUndoingObject)


   fSize   : integer;
   fMaxSize: integer;
   fData   : array [1..1] of ResTypeRec;


   Procedure TResTypeList.IResTypeRecList;

   Procedure TResTypeList.Compress;

   Procedure TResTypeList.SetSize
   (theSize : integer);

   Function TResTypeList.At
   (index : integer) : ResTypeRec;

   Procedure TResTypeList.AtPut
   (index  : integer;
    theData: ResTypeRec);

   Procedure TResTypeList.InsertBefore
   (theData: ResTypeRec;
    index  : integer);

   Procedure TResTypeList.InsertLast
   (theData : ResTypeRec);

   Procedure TResTypeList.Delete
   (index : integer);

   Procedure TResTypeList.DeleteAll;

   Function TResTypeList.FirstThat
   (Function TestItem
   (index : integer) : boolean) : integer;

   Function TResTypeList.NthThat
   (n : integer;
    Function TestItem
   (index : integer) : boolean) : integer;

   Function TResTypeList.CountOf
   (Function TestItem
   (index : integer) : boolean) : integer;

   (*
   Function TResTypeList.SortBy
   (Function CompareItems
   (index1 : integer;
    index2 : integer) : boolean);
   *)

   Function TResTypeList.Find
   (Key1 : ResType) : integer;

   Function TResTypeList.FindNthNonZeroType
   (index : integer) : integer;

   Function TResTypeList.CountOfNonZeroType : integer;

   Procedure TResTypeList.Fields
   (Procedure DoToField
   (fieldName  : Str255;
    fieldAddr  : Ptr;
    fieldType  : integer)); Override;

   Procedure TResTypeList.DynamicFields
   (Procedure DoToField
   (fieldName  : Str255;
    fieldAddr  : Ptr;
    fieldType  : integer)); Override;

   end;


   Function NewResTypeList : TResTypeList;


IMPLEMENTATION


Const

   kIncrement  = 4;
   kBaseSelfSize   = 12;


Function NewResTypeList : TResTypeList;
{——————————————————————————————————}
Var
   aResTypeRecList : TResTypeList;

begin
   New (aResTypeRecList);
   FailNil (aResTypeRecList);
   aResTypeRecList.IResTypeRecList;
   NewResTypeList := aResTypeRecList;
end;


Procedure TResTypeList.IResTypeRecList;
{———————————————————————————————————————}

begin
   fSize := 0;
   fMaxSize := 1;
   IUndoingObject;
end;


Procedure TResTypeList.Compress;
{———————————————————————————————}

begin
   if fMaxSize <> fSize then
   SetHandleSize (Handle (self),
      kBaseSelfSize + fSize * sizeof (ResTypeRec));
   fMaxSize := fSize;
end;


Procedure TResTypeList.SetSize
   (theSize: integer);
{——————————————————————————————}

begin
   theSize := ((theSize - 1) div kIncrement + 1) * kIncrement;
   if fSize < theSize then
   if fMaxSize <> theSize then begin
   SetHandleSize (Handle (self),
      kBaseSelfSize + fMaxSize * sizeof (ResTypeRec));
   FailMemError;
   end;
end;


Function TResTypeList.At
   (index : integer) : ResTypeRec;
{————————————————————————————}

begin
   {$IFC qDebug}
   if (index <= 0) | (fSize < index) then begin
   Writeln ('fSize = ', fSize : 1, '  index = ', index : 1);
   ProgramBreak ('Range Check in TResTypeList.At');
   end;
   {$ENDC}

   {$PUSH}
   {$R-}
   At := fData [index];
   {$POP}
end;

etc……